home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 020 / modula.arc / PRINTER.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-08-19  |  2.8 KB  |  146 lines
  1.  
  2. IMPLEMENTATION MODULE Printer;
  3.  
  4. FROM ASCII      IMPORT EOL;
  5. FROM FileSystem IMPORT File, Lookup, Close, WriteChar, Response, Doio;
  6. FROM Terminal   IMPORT WriteString, WriteLn;
  7. FROM System     IMPORT TermProcedure,InitProcedure;
  8. FROM Functions  IMPORT ToSpaces;
  9. FROM Strings    IMPORT Length,Copy;
  10.  
  11.  
  12. VAR
  13.  printer : File;
  14.  printHead : CARDINAL;
  15.  
  16.  
  17. PROCEDURE PrintLn;
  18. BEGIN
  19.   WriteChar(printer, EOL);
  20.   (* empty the buffer in the Modula-2 FileSystem *)
  21.   Doio(printer);
  22.   printHead := 1;
  23. END PrintLn;
  24.  
  25.  
  26. PROCEDURE PrintChar(c : CHAR);
  27. BEGIN
  28.   IF c = EOL THEN
  29.      PrintLn
  30.   ELSE
  31.      WriteChar(printer,c);
  32.   END;
  33. END PrintChar;
  34.  
  35.  
  36. PROCEDURE PrintString(str : ARRAY OF CHAR);
  37.   VAR i : CARDINAL;
  38. BEGIN
  39.   i := 0;
  40.   WHILE (i<=HIGH(str)) AND (str[i]<>0C) DO
  41.     PrintChar(str[i]);
  42.     INC(i);
  43.   END;
  44. END PrintString;
  45.  
  46.  
  47. PROCEDURE PrintStringMid(str : ARRAY OF CHAR; beg,len : CARDINAL);
  48.   VAR i : CARDINAL;
  49. BEGIN
  50.   i := beg;
  51.   WHILE (i<=HIGH(str)) AND (str[i]<>0C) AND (i < len) DO
  52.     PrintChar(str[i]);
  53.     INC(i);
  54.   END;
  55. END PrintStringMid;
  56.  
  57. (*
  58.    printHead is current location of print head on printer where next
  59.    character would be printed.   printHead = [1..132]
  60. *)
  61.  
  62.  
  63. PROCEDURE PrintTab(tab : INTEGER; str : ARRAY OF CHAR);
  64. VAR
  65.  SS : ARRAY [0..255] OF CHAR;
  66.  k : CARDINAL;
  67.  r : INTEGER;
  68.  crlf : BOOLEAN;
  69.  written : CARDINAL;
  70. BEGIN
  71.  k := 0; r := 0; crlf := FALSE;
  72.  
  73.  IF (tab < 0) THEN
  74.     crlf := TRUE;
  75.     tab := ABS(tab);
  76.  END;
  77.  
  78.  k := Length(str);
  79.  
  80.  r := tab - INTEGER(printHead);
  81.  
  82.  IF (r > 0) THEN   (* needs to be 1 for new line at tab 1 *)
  83.    ToSpaces(SS,r);
  84.    PrintString(SS);                      (* advance spaces from last position to new tab *)
  85.  END;
  86.  
  87.  IF (r > -1) THEN  (* new data to print does not overlap last printed data *)
  88.    PrintString(str);                     (* print data *)
  89.    printHead := (printHead + CARDINAL(r) + Length(str));
  90.                                          (* increment print_head for next read *)
  91.  END;
  92.  
  93.  IF (r < 0) THEN
  94.    PrintLn;
  95.    ToSpaces(SS,tab-1);
  96.    PrintString(SS);
  97.    PrintString(str);
  98.    printHead := CARDINAL(tab) + Length(str);
  99.  END;
  100.  
  101.  IF (crlf) THEN
  102.    PrintLn;
  103.    printHead := 1;
  104.  END;
  105.  
  106. END PrintTab;
  107.  
  108.  
  109. PROCEDURE PrintTabMid(tab : INTEGER; str : ARRAY OF CHAR; beg,len : CARDINAL);
  110. VAR
  111.  temps : ARRAY[0..255] OF CHAR;
  112. BEGIN
  113.  Copy(str,beg,len,temps);
  114.  PrintTab(tab,temps);
  115. END PrintTabMid;
  116.  
  117.  
  118. PROCEDURE ClosePrinter;
  119. BEGIN
  120.   Close(printer);
  121. END ClosePrinter;
  122.  
  123.  
  124. PROCEDURE OpenPrinter;
  125. BEGIN
  126.   Lookup(printer,"DK:PRN", FALSE);
  127.   IF printer.res <> done THEN
  128.     WriteString("cannot open 'PRN'");
  129.     WriteLn;
  130.     RETURN;
  131.   END;
  132.   (* printHead := 1; *)
  133. END OpenPrinter;
  134.  
  135.  
  136. PROCEDURE InitHead;
  137. BEGIN
  138.  printHead := 1;
  139. END InitHead;
  140.  
  141.  
  142. BEGIN
  143.  InitProcedure(InitHead);
  144.  TermProcedure(ClosePrinter);
  145. END Printer.
  146.